home *** CD-ROM | disk | FTP | other *** search
/ Draw & Design / Draw & Design.iso / DESIGN / DES_PS.PRE < prev    next >
Text File  |  1993-01-04  |  28KB  |  1,095 lines
  1. %-----------------------------------------------------------------------------
  2. % 9999.17 GST 194 - PostScript Preamble file for GST DesignWorks
  3. %-----------------------------------------------------------------------------
  4. % This file is inserted as the prolog when Artwork saves an EPSF file.
  5. % The program generates the initial structure comments required by EPSF
  6. % and strips comments from this file as it merges it into its output.
  7. % The main part of the job is put between the 'EndSetup' and 'Trailer' lines.
  8. %-----------------------------------------------------------------------------
  9. % Naming conventions: 
  10. % Names in all lowercase are executable procedures, like built-in postscript
  11. % procedures. Names with the first letter capitalised are variables. Names 
  12. % ending in a question mark are boolean: they can have values T or F
  13. %-----------------------------------------------------------------------------
  14. % version 0.24 4/1/93
  15. % NOTE: comments are stripped before printing!
  16. %-----------------------------------------------------------------------------
  17. %
  18. % ArtProcsDict contains all the procedures defined in this prolog
  19. % and must also have enough room for special postscript fill & line style procs.
  20. % ArtVarsDict contains all the variables etc used by the procedures.
  21.  
  22. /ArtProcsDict 160 dict def  
  23. /ArtVarsDict 100 dict def  
  24.  
  25. %---- optional jobtimeout 
  26. ArtVarsDict begin 
  27.    /Timeout 0 def 
  28. end
  29.  
  30. ArtProcsDict begin
  31.  
  32. %----- abbreviations -----%
  33.  
  34.  /bd { bind def } bind def
  35.  /ed { exch def } bd
  36.  /np /newpath load def
  37.  /cp /closepath load def
  38.  /gs { /SavePrint? Print? def gsave } bd
  39.  /gr { /Print? SavePrint? def grestore } bd
  40.  
  41.  /SS{}def
  42.  /RS{}def
  43.  /SM{}def
  44.  
  45. %----- misc tiny routines -----%
  46.  
  47. % specialscreen? returns YES if screen frequency <= 30
  48.  /specialscreen? { currentscreen pop pop 30 lt } bd
  49.  /min{2 copy gt{exch}if pop}bd % minimum of top 2 items on stack
  50.  /max{2 copy lt{exch}if pop}bd % maximum ditto
  51.  /maxof4 { 3{max}repeat } bd
  52.  /pt { 1000 mul 72 div } bd % converts points
  53.  /beginlayer { pop /LayerSave save def } bd %% layer number ignored
  54.  /endlayer { LayerSave restore } bd
  55.  
  56.  
  57. %----- path construction -----%
  58.  
  59. % P: adjusts positions of thin lines 
  60.  /p { transform round .4 add exch round .4 add exch itransform } bd
  61.  /c { p curveto } bd /m { p moveto } bd /l { p lineto } bd
  62.         
  63.  
  64. %---------- Colour handling ----------%
  65. %
  66. % define setcmykcolor if not implemented in printer. 
  67.  
  68. /mysetcmykcolor { % convert CMYK to RGB for monochrome printer
  69.   4 1 roll
  70.   3 {
  71.     3 index add 1 exch sub
  72.     dup 0 lt{pop 0}if
  73.     3 1 roll
  74.   } repeat
  75.   setrgbcolor pop
  76. } bd
  77.  
  78. /initcmykcolor {
  79.   /setcmykcolor where dup
  80.   /BwPrinter? exch not def
  81.   { 
  82.     pop 
  83.   }{
  84.     /setcmykcolor /mysetcmykcolor load def
  85.   } ifelse
  86. } bd
  87.  
  88.  
  89. %----- SETCMYK -----%
  90. % 
  91. % setcmyk is a low-level routine, called whether or not the 
  92. % printer supports colour.
  93. % It is at this level that we perform process colour separation.
  94. % We save the current CMYK setting, and routine currentcmyk can
  95. % be called to enquire the setting.
  96.  
  97. /setcmyk { 
  98.   4 copy SaveCmyk astore pop 
  99.   Comp? {               % printing a monochrome or colour composite
  100.     BwPrinter? specialscreen? and
  101.     {
  102.         % printing a special screen on a monochrome composite
  103.         % don't convert cmyk, as we'll end up with stripes or dots
  104.         % which are too small: convert the largest process colour
  105.         % component to gray. (Still not completely correct)
  106.         maxof4 1 exch sub setgray
  107.     }{
  108.       setcmykcolor 
  109.     } ifelse
  110.   }{
  111.     SpotSep? {          % if printing a spot-colour separation
  112.       blank pop         % print blank (clear or white, depending on overprint flag) 
  113.     }{                  % else printing a a process separation
  114.       4 Separation roll % bring one sep to top
  115.       dup 0 eq { 
  116.         blank pop 
  117.       }{ 
  118.         1 exch sub setgray 
  119.       } ifelse
  120.     } ifelse
  121.     pop pop pop         % clear c,m,y from stack
  122.   } ifelse
  123. } bd
  124.  
  125.  
  126. /currentcmyk {
  127.   SaveCmyk aload pop
  128. } bd
  129.  
  130.  
  131. %----- APPLYTINT -----%
  132. %
  133. % This is a lower-level colour interface
  134. % which can apply a percentage tint to a set
  135. % of CMYK percentage values.
  136. %
  137. % stack: t% c% m% y% k%
  138.  
  139. /applytint {
  140.   4{ 
  141.     4 index mul 
  142.     10000 div 
  143.     4 1 roll 
  144.   }repeat 
  145.   setcmyk 
  146.   pop 
  147. } bd
  148.  
  149.  
  150.  
  151. /blank { 
  152.   1 setgray 
  153.   /Print? OverPrint? not def 
  154.   0 0 0 0 SaveCmyk astore pop
  155. } bd
  156.  
  157.  
  158. /setgraytint {
  159.   dup 0 eq { OverPrint? not } { T } ifelse 
  160.   /Print? ed
  161.   dup /SpotTint ed
  162.   100 div 1 exch sub setgray
  163. } bd
  164.  
  165.  
  166. %----- COLPROCS -----%
  167. % 
  168. % Colprocs is a dictionary containing different procedures for 
  169. % setcolour to execute, depending on the type of the object 
  170. % on top of the stack when setcolour is called.
  171. % Colours is a dictionary of user-defined colours, indexed by name,
  172. % containing 2-level [ [C M Y K] spot? ] arrays with values in range 0-100
  173.  
  174. /Colprocs 4 dict def 
  175. Colprocs begin
  176.  
  177.   /arraytype {                          % [ C M Y K ] process colour mix
  178.       100 exch aload pop applytint      % apply 100% tint to the mix
  179.   } bd
  180.  
  181.   % perform spot-colour separation 
  182.   /nametype {                   % stack: tint name
  183.     dup Colours exch get        % tint name [ [ C M Y K ] Spot? ]
  184.     1 get not Comp? or {        % if not a spot colour, or printing composite
  185.       Colours exch get          % tint [ [ C M Y K ] Spot? ]
  186.       0 get aload pop           % tint c m y k
  187.       applytint 
  188.     }{                          % else spot colour & not composite printout
  189.       SpotSep? {                % if printing a spot separation...
  190.         Separation eq {            % is spot colour same as this separation?
  191.           setgraytint           % if so, set percentage tint
  192.         }{
  193.           pop blank             % wrong spot sep: print nothing
  194.         } ifelse
  195.       }{
  196.         pop pop blank           % printing a process sep: print nothing
  197.       } ifelse
  198.     } ifelse
  199.   } bd
  200.  
  201.   /integertype {                % apply percentage tint to black
  202.     0 0 0 100 applytint 
  203.   } bd
  204.  
  205.   /realtype /integertype load def
  206. end % Colprocs
  207.  
  208.  
  209.  
  210. %----- SETCOLOUR -----%
  211. %
  212. % This routine is the top-level color interface. 
  213. % It can be called in three different ways:
  214. %   number      SETCOLOUR --  % number is %black, 0=white 100=black
  215. %   [ 4-array ] SETCOLOUR --  % array contains C M Y K percentages
  216. %   number name SETCOLOUR --  % percentage tint of a named colour
  217.  
  218. /setcolour { 
  219.   /Print? T def
  220.   /SpotTint 0 def % preset spot colour tint value to zero
  221.   dup type Colprocs exch get exec 
  222. } bd
  223.  
  224.  
  225.  
  226. %----- FILL and STROKE -----%
  227. %
  228. % Winding? is a boolean which selects whether we use the winding-number fill
  229. % or the even-odd fill algorithm. Print? is a boolean used to enable or 
  230. % disable fill and stroke when overprinting separations, set by setcolour 
  231. % and blank.
  232.  
  233.  /ovp { /OverPrint? ed } bd
  234.  /wif { /Winding? T def } bd
  235.  /eof { /Winding? F def } bd
  236.  
  237.  /~stroke { Print? { stroke } if } bd
  238.  /_stroke { setcolour ~stroke } bd
  239.  /~fill { Print? { Winding? { fill } { eofill } ifelse } if } bd
  240.  /_fill { setcolour ~fill } bd
  241.  /_clip { Winding? { clip } { eoclip } ifelse } bd
  242.  
  243.  /sml { 2 div sin 1 exch div setmiterlimit } bd
  244.  /sline { setlinewidth setlinejoin setlinecap } bd
  245.  /li { Lines exch get exec } bd
  246.  /fi { Fills exch get exec } bd
  247.  
  248.  
  249.  
  250. %----- GROUPS -----%
  251.  
  252.  /bg { gsave concat } bd % matrix BG -- 
  253.  /eg { grestore } bd 
  254.  
  255.  
  256.  
  257. %----- Utility Routines -----%
  258.  
  259.  /getbox { /Top ed /Right ed /Bottom ed /Left ed } bd 
  260.  
  261.  /arcpop { arcto 4 { pop } repeat } bd
  262.  
  263.  
  264.  
  265. %----- basic shapes: ROUND BOX -----%
  266.  
  267. /shape_rbox {
  268.   /Rad ed
  269.   getbox
  270.   matrix currentmatrix
  271.     exch concat
  272.     np Left Right add 2 div Top p moveto % top centre
  273.     Right Top p Right Bottom p Rad arcpop
  274.     Right Bottom p Left Bottom p Rad arcpop
  275.     Left Bottom p Left Top p Rad arcpop
  276.     Left Top p Right Top p Rad arcpop cp 
  277.   setmatrix
  278. } bd
  279.  
  280.  
  281.  
  282. %----- basic shapes: BOX -----%
  283. /boxpath {
  284.   np Left Top m Right Top l
  285.   Right Bottom l Left Bottom l cp
  286. } bd
  287.  
  288. /shape_box {
  289.   getbox
  290.   matrix currentmatrix
  291.     exch concat boxpath
  292.   setmatrix
  293. } bd
  294.  
  295.  
  296. /clip_box { getbox boxpath eoclip } bd
  297.  
  298.  
  299.  
  300. %----- basic shapes: ELLIPSE -----%
  301.  
  302. /shape_ellipse {
  303.   getbox
  304.   matrix currentmatrix 
  305.     exch concat
  306.     % map unit circle to bounding box
  307.     Left Top translate
  308.     Right Left sub Bottom Top sub scale
  309.     np .5 .5 .5 0 360 arc cp
  310.   setmatrix
  311. } bd
  312.  
  313.  
  314. %----- IMAGES -----%
  315.  
  316. /artimage {
  317.   gs
  318.     /Bgd? exch def
  319.     /Mask? exch def
  320.     /Bits exch def 
  321.     /Height exch def
  322.     /Width exch def
  323.     getbox concat 
  324.  
  325.     Bgd? { setcolour boxpath wif ~fill } if
  326.  
  327.     Left Top translate 
  328.     Right Left sub 
  329.     Bottom Top sub scale
  330.  
  331.     Mask? {   
  332.       setcolour
  333.         Width Height true [ Width 0 0 Height 0 0 ] 
  334.         { currentfile ImageBuff readhexstring pop }
  335.       imagemask
  336.     }{  Width Height Bits [ Width 0 0 Height 0 0 ] 
  337.         { currentfile ImageBuff readhexstring pop }
  338.       image
  339.     } ifelse
  340.   gr
  341. } bd    
  342.  
  343.  
  344. /densitylookup {
  345.    densitygreys 1 sub mul cvi  % convert input grey level to integer
  346.    densityarray exch get   % lookup value (range 0..2000)
  347.    1000 div             % convert to density 0.0-2.0
  348.    neg 10 exch exp      % reflectance = 10 ^ -density
  349. } bd
  350.  
  351. /palettelookup {
  352.    palettecols 1 sub mul cvi  % convert input grey level to integer
  353.    palettearray exch get   % lookup value (range 0..1000)
  354.    1000 div             % convert to reflectance 0..1
  355. } bd
  356.  
  357. /artcolimage {
  358.   gs
  359.     /Proc exch load def 
  360.     /Height ed /Width ed
  361.     getbox concat            
  362.     Left Top translate 
  363.     Right Left sub 
  364.     Bottom Top sub scale
  365.  
  366.     /Im? T def
  367.     /Wn Width def
  368.  
  369.     Width Height 8 [ Width 0 0 Height 0 0 ] 
  370.     /Proc load 
  371.     false 3 colorimage
  372.  
  373.     gr
  374. } bd    
  375.  
  376. /img4 {
  377.  Im? {
  378.    % read one byte from the file
  379.    currentfile ImageBuff readhexstring pop 
  380.    0 get -4 bitshift
  381.  }{
  382.    ImageBuff 0 get
  383.  }ifelse
  384.  
  385.  %--- see if we're at the end of a raster line
  386.  Wn 1 sub dup 0 eq { pop Width T }{ Im? not } ifelse
  387.  /Im? ed /Wn ed
  388.  
  389.  % use result as index into palette
  390.  15 and palettearray exch get 
  391. } bd
  392.  
  393.  
  394. /img8 {
  395.    currentfile ImageBuff readhexstring pop % read one byte from the file
  396.    0 get palettearray exch get % use that as index into palette
  397. } bd
  398.  
  399. /img24 {
  400.    currentfile ImageRgbBuff readhexstring pop % read 3 bytes from the file
  401. } bd
  402.  
  403.  
  404. %----- normalised transfer function -----%
  405.  
  406. /normalise
  407. {
  408.   mark
  409.   1.0 1.0 .98 .9 .82 .68 
  410.   .56 .48 .28 .1 .06 .0                 % i [ nvalues
  411.   counttomark                           % i [ nvalues n
  412.   dup 3 add -1 roll exch                % [ nvalues input n
  413.   2 sub mul                             % [ nvalues j     % j = (n-2)*i k=floor(j)
  414.   dup floor cvi                         % [ nvalues j k
  415.   dup 3 1 roll sub                      % [ nvalues k j-k
  416.   exch dup                              % [ nvalues j-k k k
  417.   3 add index exch 2 add index dup      % [ nvalues j-k table[k+1] table[k] table[k]
  418.   4 1 roll                              % [ nvalues table[k] j-k table[k+1] table[k]
  419.   sub mul add                           % [ nvalues result    % result = ( table[k] + (j-k)*(table[k+1]-table[k]) )
  420.   counttomark 1 add 1 roll              % result [ nvalues
  421.   cleartomark                           % result
  422. } bd
  423.  
  424.  
  425. /?Negative {} bd % if printing negative, this procedure changes
  426.  
  427. /neg_transfer { 
  428.   /?Negative { 1 exch sub } bd 
  429.   {  ?Negative normalise DefTran } bind settransfer   
  430.   gs clippath 1 setgray fill gr              % then fill with white
  431.   
  432. } bd
  433.  
  434. %----- Special Effects: Flatten Path -----%
  435. %
  436. % flatten path, adjust 'setflat' until it works.
  437. % no parameters, no output. NOTE: this leaves a 'gs' in effect
  438.  
  439. /flatclip { 
  440.   currentflat
  441.   { 
  442.     gs
  443.     { flattenpath _clip } stopped not {exit}if
  444.     % ie, if not stopped due to error, exit loop
  445.     
  446.     % but if the error was other than limitcheck, stop now!
  447.     $error /errorname get /limitcheck ne { stop } if
  448.  
  449.     % if flatness gets too high, give up
  450.     currentflat 80 gt { exit } if
  451.     
  452.     % try again with flatter paths
  453.     gr currentflat 1.1 mul 1 add setflat
  454.   }loop
  455.   setflat
  456. } bd
  457.  
  458. /flatp { 
  459.   currentflat
  460.   { {flattenpath} stopped not {exit}if
  461.     currentflat 1 add setflat
  462.   }loop
  463.   setflat
  464. } bd
  465.  
  466.  
  467.  
  468. %----- Special Effects: Clip to Path -----%
  469. %
  470. % Also computes bounding box and width and height.
  471. % NOTE: flatclip saves graphics state
  472.  
  473. /clipper {
  474.   flatclip pathbbox 
  475.   /Bottom ed /Right ed /Top ed /Left ed
  476.   Right Left sub /Width ed
  477.   Bottom Top sub /Height ed
  478. } bd
  479.  
  480.  
  481.  
  482.  
  483. %----- Example of a special fill routine -----%
  484.  
  485. /examplefill {
  486.   clipper %gs implied
  487.     Left Top translate
  488.     % insert commands to fill area from (0,0) to (Width,Height)
  489.     Width Height scale
  490.     % or insert commands to fill unit square
  491.   gr
  492. } bd
  493.  
  494.  
  495.  
  496. %----- Graduated Fill Support Code -----%
  497.  
  498. /GradFillDict 30 dict def
  499.  
  500. /GrayProcs [ 
  501.   {} % 0: radial
  502.   {dup mul} bind % 1: spherical 
  503.   {} % 2
  504.   {} % 3: linear
  505.   {9 mul 1 add log} bind % 4: logarithmic
  506.   {dup 1 exch sub mul 4 mul} bind % 5: cylindrical 
  507. ] def
  508.  
  509. /grayconv { % start diff ingray GRAYCONV outgray 
  510.   GrayProcs GradType get exec
  511.   mul add
  512. } bd
  513.  
  514.  
  515. /grad_common_init {
  516.   %---- initialise variables in local dictionary
  517.  
  518.   % convert start colour to CMYK and get values
  519.   setcolour currentcmyk 
  520.   /StartK ed /StartY ed /StartM ed /StartC ed
  521.   /StartT SpotTint def
  522.  
  523.   % do the same for the end colour
  524.   setcolour currentcmyk
  525.   /EndK ed /EndY ed /EndM ed /EndC ed
  526.   /EndT SpotTint def 
  527.  
  528.   % replace End with End-Start
  529.   /EndC EndC StartC sub def
  530.   /EndM EndM StartM sub def
  531.   /EndY EndY StartY sub def
  532.   /EndK EndK StartK sub def
  533.   /EndT EndT StartT sub def
  534.  
  535.   % If printing colour separations, if the separation has
  536.   % the same tint for the start and end of the grad fill,
  537.   % treat it as a solid fill to save time.
  538.  
  539.   /SolidFill? F def
  540.  
  541.   Comp? not {           % not printing a composite - separations
  542.  
  543.     SpotSep? {          % printing a spot colour sep
  544.       StartT setgraytint
  545.       EndT 0 eq /SolidFill? ed
  546.     }{                  % printing a process sep
  547.       mark
  548.       StartC StartM StartY StartK 4 Separation roll
  549.       100 mul setgraytint % 0.22
  550.  
  551.       EndC EndM EndY EndK 4 Separation roll
  552.       0 eq /SolidFill? ed
  553.       
  554.       cleartomark
  555.     } ifelse
  556.  
  557.   } if
  558. } bd
  559.  
  560.  
  561. /grad_common_middle {
  562.   /X ed
  563.   SpotSep? {
  564.     StartT EndT X grayconv
  565.     setgraytint 
  566.   }{
  567.     StartC EndC X grayconv
  568.     StartM EndM X grayconv
  569.     StartY EndY X grayconv
  570.     StartK EndK X grayconv
  571.     setcmyk
  572.   } ifelse
  573. } bd
  574.  
  575.  
  576.  
  577.  
  578. %----- Graduated Fill: linear, logarithmic, cylindrical -----%
  579. %
  580. % parameters: angle type startcolour endcolour
  581. % each colour can be either a number (for a black tint)
  582. % a number and a name, or an array of four values: 
  583. % the same as setcolour.
  584. % type: 3=linear 4=logarithm 5=cylinder
  585.  
  586. /linfill {
  587.   GradFillDict begin
  588.   grad_common_init
  589.   /GradType ed
  590.   neg /Theta ed
  591.   /Steps GradType 3 ne { 100 } { 32 } ifelse def
  592.   % also uses Top Bottom Left Right Width Height in dictionary
  593.  
  594.   SolidFill? {
  595.  
  596.     ~fill       % separation, and fill is solid for this sep
  597.   }{
  598.  
  599.     %---- prepare to fill to clipping path 
  600.     %     and setup transformation matrix
  601.     gs
  602.       Theta rotate 
  603.       clipper %gs implied
  604.       Left Top translate
  605.       Width Height scale
  606.       1 Steps 1 add div setlinewidth
  607.  
  608.       0 1 Steps { 
  609.         dup Steps div
  610.  
  611.         grad_common_middle
  612.  
  613.         newpath
  614.           .5 add 
  615.           Steps 1 add 
  616.         div 0
  617.         moveto 
  618.  
  619.         0 1 rlineto
  620.         ~stroke
  621.  
  622.       } bind for
  623.     gr gr
  624.  
  625.   }ifelse
  626.  
  627.   end
  628. } bd
  629.  
  630.  
  631. %----- Radial/Spherical Graduated Fill -----%
  632. %
  633. % stack: type startcolour endcolour
  634. % type: 0=radial, 1=spherical
  635.  
  636. /radfill { 
  637.   GradFillDict begin
  638.   grad_common_init
  639.   /GradType ed
  640.   /Steps GradType 0 ne { 64 } { 32 } ifelse def
  641.  
  642.   SolidFill? {
  643.     ~fill       % separation, and fill is solid for this sep
  644.   }{
  645.  
  646.     clipper %gs implied
  647.       Left Right add 2 div Top Bottom add 2 div translate % centre
  648.       Width dup mul Height dup mul add sqrt 2 div dup scale % half diagonal
  649.       Steps -1 1 { % loop to fill unit circle centred on origin
  650.         /Rad exch Steps div def
  651.  
  652.         Rad grad_common_middle
  653.  
  654.         np 0 Rad moveto 0 0 Rad 0 360 arc cp
  655.         ~fill
  656.       } bind for
  657.     gr
  658.  
  659.   } ifelse
  660.  
  661.   end
  662. } bd
  663.  
  664. %----- Arrowheads -----------
  665.  
  666. /ArrowProcs [
  667. {} 
  668. {np 0 25 m 50 0 l 0 -25 l cp fill }
  669. {np 0 25 m 50 0 l 0 -25 l cp stroke }
  670. {np 0 0 m -10 25 l 50 0 l -10 -25 l cp fill }
  671. {np 0 0 m -10 25 l 50 0 l -10 -25 l cp stroke }
  672. {np -50 25 m 0 0 l -50 -25 l stroke }
  673. {np 0 25 m 0 -25 l stroke }
  674. {np 2 setlinejoin -50 25 m 0 0 l -50 -25 l 0 25 m 0 -25 l stroke }
  675. {np 50 25 m 0 0 l 50 -25 l stroke }
  676. {np 100 25 m 50 0 l 100 -25 l 50 0 m 0 0 l 50 25 m 0 0 l 50 -25 l stroke }
  677. {np 100 25 m 50 0 l 100 -25 l 45 -25 l -5 0 l 45 25 l cp fill }
  678. ] def
  679.  
  680. % type dx dy scale x y arrow
  681.  
  682. /arrow {
  683.   gs
  684.     translate 
  685.     dup 20 lt { pop 20 } if
  686.     10 div dup scale 
  687.     exch atan 180 add rotate
  688.     0 0 10 sline
  689.     Print? {
  690.       ArrowProcs exch get exec
  691.     }{
  692.       pop
  693.     } ifelse
  694.     gr
  695. } bd
  696.  
  697.  
  698.  
  699. %----- Tiled Fill -----------
  700.  
  701. /TiDict 20 dict def
  702.  
  703. /tipos {        % pos wid
  704.   dup           % pos wid wid
  705.   3 1 roll      % wid pos wid
  706.   div floor mul % pos'
  707. } bd
  708.  
  709. /_tile { % dx dy proc scaledwidth scaledheight scale(percent) angle
  710.   TiDict begin
  711.   /TiAngle ed 
  712.   100 div /Tscale ed
  713.   Tscale div /TiHgt ed 
  714.   Tscale div /TiWid ed 
  715.   /TiProc ed
  716.   % leave just dx & dy on stack
  717.  
  718.   gs 1 setgray ~fill gr % 0.18: fill shape with white
  719.  
  720.   gs
  721.     translate TiAngle neg rotate Tscale dup scale
  722.     flatclip pathbbox /TiBottom ed /TiRight ed /TiTop ed /TiLeft ed
  723.     TiTop TiHgt tipos TiHgt TiBottom {
  724.       gs 0 exch translate
  725.         TiLeft TiWid tipos TiWid TiRight {
  726.           gs 0 translate /TiProc load 
  727.           ArtVarsDict begin exec end gr
  728.         } for
  729.       gr
  730.     }for
  731.   gr gr
  732.   end
  733. } bd
  734.  
  735.  
  736. %--------- TEXT HANDLING -----------%
  737.  
  738.  /begintext { matrix currentmatrix } bd % leave current matrix on top of stack
  739.  /endtext { setmatrix } bd     % restore saved matrix
  740.  /ntm { exch dup setmatrix exch concat } bd % newtextmatrix: matrix
  741.  
  742.  
  743.  /textstyle { % proc
  744.   /SimpleText? F def
  745.   /filltext exch bind def
  746.  } bd
  747.  
  748.  /plaintext { % <colour & tint>
  749.   F ovp
  750.   setcolour
  751.   /SimpleText? T def
  752.  } bd
  753.  
  754. /tf { % textfont: size width fontname
  755.   findfont 3 1 roll
  756.   exch neg matrix scale makefont
  757.   setfont
  758. } bd
  759.  
  760. /txt { % x y string
  761.   3 1 roll moveto
  762.   SimpleText?
  763.   {
  764.     Print? { show } if
  765.   }{
  766.     {
  767.       currentpoint np moveto
  768.       tempstr 0 2 index put 
  769.       tempstr T charpath filltext
  770.       pop
  771.     } forall
  772.   } ifelse
  773. } bd
  774.  
  775. /filltext { } def
  776.  
  777.  
  778. /title { 
  779.   gs
  780.   moveto
  781.   {270 rotate} if
  782.   100 pt exch div dup neg scale
  783.   /Helvetica findfont 10 scalefont setfont
  784.   show
  785.   gr
  786. } bd
  787.  
  788. /regmark {
  789.   gs translate 
  790.   1 setlinewidth
  791.   np -100 0 moveto 100 0 lineto stroke
  792.   np 0 -100 moveto 0 100 lineto stroke
  793.   np 0 0 50 0 360 arc stroke
  794.   gr
  795. } bd
  796.  
  797. /cropmark {
  798.   gs 1 setlinewidth np moveto lineto stroke gr
  799. } bd
  800.  
  801. %----- Routines to rearrange font to match Windows Ansi character set -----%
  802.  
  803. /ANSI_Vec [
  804.  /grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis
  805.  /ring/cedilla/hungarumlaut/ogonek/caron/dotlessi/.notdef/.notdef
  806.  /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
  807.  /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
  808.  /space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle
  809.  /parenleft/parenright/asterisk/plus/comma/hyphen/period/slash
  810.  /zero/one/two/three/four/five/six/seven
  811.  /eight/nine/colon/semicolon/less/equal/greater/question
  812.  /at/A/B/C/D/E/F/G
  813.  /H/I/J/K/L/M/N/O
  814.  /P/Q/R/S/T/U/V/W
  815.  /X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore
  816.  /grave/a/b/c/d/e/f/g
  817.  /h/i/j/k/l/m/n/o
  818.  /p/q/r/s/t/u/v/w
  819.  /x/y/z/braceleft/bar/braceright/asciitilde/.notdef
  820.  /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
  821.  /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
  822.  /.notdef/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash
  823.  /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
  824.  /space/exclamdown/cent/sterling/currency/yen/brokenbar/section
  825.  /dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron
  826.  /degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered
  827.  /cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown
  828.  /Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla
  829.  /Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis
  830.  /Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply 
  831.  /Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls
  832.  /agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla
  833.  /egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis
  834.  /eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide 
  835.  /oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis
  836. ] def
  837.  
  838.  
  839. /ReEncDict 12 dict def
  840.  
  841. /ischar {
  842.   BaseFontDict /CharStrings get exch known
  843. }bd
  844.  
  845. /mapch {
  846.   dup ischar not 
  847.   {pop /.notdef} if 
  848.   NewFont /Encoding get 3 1 roll put 
  849. }bd
  850.  
  851. /mapdegree{ 16#b0 /degree ischar {/degree}{/ring} ifelse mapch } bd
  852.  
  853. /mapbb { 16#a6 /brokenbar ischar {/brokenbar}{/bar}ifelse mapch } bd
  854.  
  855. /reencoderange {  
  856.   { dup ANSI_Vec exch get mapch } for
  857. } bd
  858.  
  859. /reencode {
  860.   0 1 15 reencoderange
  861.   160 1 255 reencoderange
  862.   16#27 /quotesingle mapch
  863.   16#60 /grave mapch
  864.   16#7C /bar mapch
  865.   mapdegree mapbb
  866. } bd
  867.  
  868. /ansifont {
  869.  ReEncDict begin
  870.    /NewFontName exch def 
  871.    /BaseFontName exch def
  872.    FontDirectory NewFontName known not
  873.    {
  874.      /BaseFontDict BaseFontName findfont def
  875.      /NewFont BaseFontDict maxlength dict def
  876.      BaseFontDict {
  877.        exch dup /FID ne { 
  878.          dup /Encoding eq { 
  879.            exch 
  880.            dup length array copy 
  881.            NewFont 3 1 roll put 
  882.          }{ 
  883.            exch 
  884.            NewFont 3 1 roll put 
  885.          }
  886.          ifelse
  887.        }{
  888.          pop pop
  889.        }ifelse
  890.      }forall
  891.      NewFont /FontName NewFontName put
  892.  
  893.      % look at the charstrings see if it has 'A' and 'Z':
  894.      % if so, remap the font. If not, leave it alone!
  895.      /A ischar /Z ischar and { reencode } if
  896.      NewFontName NewFont definefont pop
  897.    } if
  898.    NewFontName
  899.  end
  900. } bind def
  901.  
  902.  
  903. %----- Colour Separation Setup Procedures -----%
  904. %
  905. % Separation: if undefined, a composite is produced
  906. %       if numeric, a process colour separation is produced
  907. %               3=cyan, 2=magenta, 1=yellow, 0=black
  908. %       if a name of a spot colour, that spot separation is produced
  909. %
  910. % example:
  911. %       /Separation 3 def setupsep 
  912. %       /Separation /Reflex_Blue def setupsep
  913.  
  914.  
  915. /setupsep {
  916.   /Separation where {           % is 'Separation' defined?
  917.     pop
  918.     /Comp? F def                % yes: we're doing a separation.
  919.     Separation type             % is it a number?
  920.     0 type ne 
  921.     /SpotSep? ed          % if not, we're doing a spot colour.
  922.   }{
  923.     /Comp? T def                % separation not defined: doing a composite.
  924.     /SpotSep? F def
  925.   } ifelse
  926.  
  927.   statusdict begin Timeout setjobtimeout end % timeout per separation
  928.  
  929. } bd
  930.  
  931.  
  932. /setsepscreen { AngleFix add /DefScrFun load setscreen } bd
  933.  
  934.  
  935. %---------- included EPSF procedure
  936.  
  937. /include_epsf {
  938.   /Bottom ed /Left ed 
  939.   gsave concat
  940.  
  941.   % assumes that bottom-left of rect corresponds to EPSF's origin
  942.   Left Bottom translate
  943.   1000 72 div dup neg scale
  944.  
  945.   /EpsfSave save def
  946.  
  947.   /showpage { } def
  948.  
  949.   currentfile cvx stopped { % did it stop?
  950.     $error /newerror get {  % was it a new error?
  951.       handleerror           % put out an error message
  952.  
  953.       % skip to end of included file
  954.       { % loop
  955.         currentfile LineBuff readline {
  956.           (\045\045EndEPSF) eq { exit } if
  957.         }{
  958.           % can't find end marker - hit EOF?
  959.         } ifelse
  960.       } loop
  961.  
  962.     } if
  963.   }{
  964.     % didn't stop - hit EOF?
  965.   } ifelse
  966.   $error /newerror F put
  967.  
  968.   EpsfSave restore
  969.   grestore
  970. } bd
  971.  
  972. %--------------------------------- downloaded font stuff -------------------
  973.  
  974. /BuildDict 3 dict def
  975.  
  976. /PointProcs[{}{closepath moveto}bind/lineto load/curveto load]def
  977.  
  978. /gst_char { n 8 bitshift add /n ed /i i 1 add def
  979. i 3 eq {
  980.   n 2047 and dup 1600 gt { 2048 sub } if
  981.   n -11 bitshift 2047 and dup 1600 gt { 2048 sub } if
  982.   n -22 bitshift 3 and PointProcs exch get exec
  983.   /n 0 def /i 0 def
  984.   } if
  985. } bd
  986.  
  987. /gst_build { 
  988. exch begin 
  989.   BuildDict begin 
  990.     Encoding exch get 
  991.     /n 0 def /i 0 def
  992.     dup Metrics exch get 0 setcharwidth 
  993.     newpath CharStrings exch get { gst_char } forall 
  994.     closepath fill 
  995.   end 
  996. end
  997. } bd
  998.  
  999. /gst_fast { 
  1000. exch begin 
  1001.   Encoding exch get 
  1002.   dup Metrics exch get 0 setcharwidth 
  1003.   CharStrings exch get cvx exec 
  1004. end
  1005. } bd
  1006.  
  1007. /newgstfont {
  1008.   ReEncDict begin
  1009.   /NewFontSize ed
  1010.   /NewFontId ed
  1011.   /NewFontFast ed
  1012.   /NewFontName ed
  1013.   10 dict dup begin
  1014.     /FontMatrix [ .001 0 0 .001 0 0 ] def
  1015.     /FontType 3 def
  1016.     /FontBBox [ -400 -300 1600 1000 ] def
  1017.     /Encoding ANSI_Vec def
  1018.     /Metrics NewFontSize dict def Metrics /.notdef 0 put
  1019.     /CharStrings NewFontSize dict def CharStrings /.notdef () put
  1020.     /UniqueID 16#ff0000 NewFontId add def
  1021.     /gst_fast /gst_build NewFontFast { exch } if load /BuildChar ed pop
  1022.   end
  1023.   NewFontName exch definefont pop
  1024.   NewFontName
  1025. end
  1026. } bd
  1027.     
  1028. /NewCharDict 4 dict def
  1029.  
  1030. /newchar { 
  1031. NewCharDict begin
  1032.   /Proc ed
  1033.   /Wid ed
  1034.   /Code ed
  1035.   dup findfont begin
  1036.     Encoding Code get dup
  1037.     CharStrings exch /Proc load put
  1038.     Metrics exch Wid put
  1039.   end
  1040. end
  1041. } bd
  1042.  
  1043.  
  1044. %%EndProlog
  1045.  
  1046. %%BeginSetup
  1047.  
  1048. /ArtworkSave save def
  1049.   ArtVarsDict begin
  1050.  
  1051.   % boolean abbreviations
  1052.   /T true def /F false def
  1053.  
  1054.   % initialise default line end, join, mitre limit etc
  1055.   1 1 14 sline 10 sml
  1056.  
  1057.   % initialise misc variables
  1058.   /tempstr 1 string def         % buffer for text
  1059.   /ImageBuff 1 string def       % buffer for bitmap images
  1060.   /ImageRgbBuff 3 string def    % buffer for bitmap images
  1061.   /LineBuff 256 string def      % buffer for included epsfs
  1062.   /SimpleText? T def            % flag for fast text handling
  1063.   /Wind? T def                  % winding fill on/off
  1064.   /Print? T def                 % print flag used by colour separation stuff
  1065.   /SaveCmyk 4 array def         % current C,M,Y,K colour
  1066.   /Imat matrix identmatrix def  % an indentity matrix
  1067.   /bignum 2 31 exp 1 sub def    % for random number generator
  1068.   initcmykcolor
  1069.  
  1070.   % determine current transformation's rotation, (eg for landscape)
  1071.   % which will need to be applied to any screen angles
  1072.   /AngleFix 1 0 dtransform exch atan def
  1073.  
  1074.   % record the current screen function, angle and frequency
  1075.   currentscreen /DefScrFun exch def pop pop
  1076.   ArtProcsDict /Screens known {
  1077.     currentscreen Screens exch 0 exch put pop pop
  1078.   } if
  1079.  
  1080.   % record the current transfer function, and set up a normalised
  1081.   % transfer function followed by the default
  1082.   /DefTran currenttransfer def
  1083.   {normalise DefTran}bind settransfer
  1084.  
  1085.  
  1086. %%EndSetup
  1087.  
  1088. %%Trailer
  1089. end % ArtVarsDict
  1090. ArtworkSave restore
  1091. end % ArtProcsDict
  1092. %%EOF
  1093.  
  1094.  
  1095.